remotesChanged
findinmap
-{- Filters a list of remotes to ones that have the listed uuids. -}
-remotesWithUUID :: [Remote] -> [UUID] -> [Remote]
-remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
-
-{- Filters a list of remotes to ones that do not have the listed uuids. -}
-remotesWithoutUUID :: [Remote] -> [UUID] -> [Remote]
-remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
-
{- List of repository UUIDs that the location log indicates may have a key.
- Dead repositories are excluded. -}
keyLocations :: Key -> Annex [UUID]
keyLocations key = trustExclude DeadTrusted =<< loggedLocations key
-{- Whether to include remotes that have annex-ignore set. -}
-newtype IncludeIgnored = IncludeIgnored Bool
-
{- Cost ordered lists of remotes that the location log indicates
- may have a key.
-
-}
keyPossibilities :: IncludeIgnored -> Key -> Annex [Remote]
keyPossibilities ii key = do
- u <- getUUID
- -- uuids of all remotes that are recorded to have the key
- locations <- filter (/= u) <$> keyLocations key
- speclocations <- map uuid
- . filter (remoteAnnexSpeculatePresent . gitconfig)
- <$> remoteList
- -- there are unlikely to be many speclocations, so building a Set
- -- is not worth the expense
- let locations' = speclocations ++ filter (`notElem` speclocations) locations
- fst <$> remoteLocations ii locations' []
+ locations <- keyLocations key
+ keyPossibilities' ii key locations =<< remoteList
{- Given a list of locations of a key, and a list of all
- trusted repositories, generates a cost-ordered list of
- remotes that contain the key, and a list of trusted locations of the key.
-}
remoteLocations :: IncludeIgnored -> [UUID] -> [UUID] -> Annex ([Remote], [UUID])
-remoteLocations (IncludeIgnored ii) locations trusted = do
- let validtrustedlocations = nub locations `intersect` trusted
-
- -- remotes that match uuids that have the key
- allremotes <- remoteList
- >>= if not ii
- then filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . gitconfig)
- else return
- let validremotes = remotesWithUUID allremotes locations
-
- return (sortBy (comparing cost) validremotes, validtrustedlocations)
+remoteLocations ii locations trusted =
+ remoteLocations' ii locations trusted =<< remoteList
{- Displays known locations of a key and helps the user take action
- to make them accessible. -}
import Config.Cost
import Remote.Helper.Special
import Remote.Helper.ExportImport
+import Remote.List.Util
import Annex.SpecialRemote.Config
import Annex.UUID
import Annex.Content
import Annex.Tmp
import Annex.GitShaKey
import Annex.CatFile
+import qualified Annex.Transfer
import Logs.MetaData
import Logs.EquivilantKeys
+import Logs.Location
import Utility.Metered
import Utility.TimeStamp
import Utility.Env
-> ComputeState
-> ImmutableState
-> (OsPath -> Annex (Key, Maybe (Either Git.Sha OsPath)))
+ -- ^ get input file's content, or Nothing when adding a computation
+ -- without actually performing it
-> (ComputeState -> OsPath -> NominalDiffTime -> Annex v)
-> Annex v
runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate) getinputcontent cont =
getinputcontent state f =
case M.lookup (fromOsPath f) (computeInputs state) of
Just inputkey -> case keyGitSha inputkey of
- Nothing -> do
- obj <- calcRepo (gitAnnexLocation inputkey)
- -- XXX get input object when not present
- return (inputkey, Just (Right obj))
+ Nothing ->
+ let retkey = do
+ obj <- calcRepo (gitAnnexLocation inputkey)
+ return (inputkey, Just (Right obj))
+ in ifM (inAnnex inputkey)
+ ( retkey
+ , do
+ getinputcontent' f inputkey
+ retkey
+ )
Just gitsha ->
return (inputkey, Just (Left gitsha))
Nothing -> error "internal"
+
+ getinputcontent' f inputkey = do
+ remotelist <- Annex.getState Annex.remotes
+ locs <- loggedLocations inputkey
+ rs <- keyPossibilities' (IncludeIgnored False) inputkey locs remotelist
+ if null rs
+ then return ()
+ else void $ firstM (getinputcontentfrom f inputkey) rs
+
+ -- TODO cycle prevention
+ getinputcontentfrom f inputkey r = do
+ showAction $ "getting input " <> QuotedPath f
+ <> " from " <> UnquotedString (name r)
+ Annex.Transfer.download r inputkey (AssociatedFile (Just f))
+ Annex.Transfer.stdRetry Annex.Transfer.noNotification
computeskey state =
case M.keys $ M.filter (== Just k) (computeOutputs state) of
{- git-annex remote list utils
-
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2025 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
import Annex.Common
import qualified Annex
import qualified Git.Config
+import Annex.UUID
+import Types.Remote
+import Config.DynamicConfig
+
+import Data.Ord
{- Call when remotes have changed. Re-reads the git config, and
- invalidates the cache so the remoteList will be re-generated next time
, Annex.gitremotes = Nothing
, Annex.repo = newg
}
+
+{- Whether to include remotes that have annex-ignore set. -}
+newtype IncludeIgnored = IncludeIgnored Bool
+
+keyPossibilities'
+ :: IncludeIgnored
+ -> Key
+ -> [UUID]
+ -- ^ uuids of remotes that are recorded to have the key
+ -> [Remote]
+ -- ^ all remotes
+ -> Annex [Remote]
+keyPossibilities' ii key remotelocations rs = do
+ u <- getUUID
+ let locations = filter (/= u) remotelocations
+ let speclocations = map uuid
+ $ filter (remoteAnnexSpeculatePresent . gitconfig) rs
+ -- there are unlikely to be many speclocations, so building a Set
+ -- is not worth the expense
+ let locations' = speclocations ++ filter (`notElem` speclocations) locations
+ fst <$> remoteLocations' ii locations' [] rs
+
+remoteLocations' :: IncludeIgnored -> [UUID] -> [UUID] -> [Remote] -> Annex ([Remote], [UUID])
+remoteLocations' (IncludeIgnored ii) locations trusted rs = do
+ let validtrustedlocations = nub locations `intersect` trusted
+
+ -- remotes that match uuids that have the key
+ allremotes <- if not ii
+ then filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . gitconfig) rs
+ else return rs
+ let validremotes = remotesWithUUID allremotes locations
+
+ return (sortBy (comparing cost) validremotes, validtrustedlocations)
+
+{- Filters a list of remotes to ones that have the listed uuids. -}
+remotesWithUUID :: [Remote] -> [UUID] -> [Remote]
+remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
+
+{- Filters a list of remotes to ones that do not have the listed uuids. -}
+remotesWithoutUUID :: [Remote] -> [UUID] -> [Remote]
+remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
* get input files for a computation (so `git-annex get .` gets every file,
even when input files in a directory are processed after computed files)
+ started implementation, but must avoid cycles!
+
* addcomputed should honor annex.addunlocked.
* Perhaps recompute should write a new version of a file as an unlocked
that recompute should also support recomputing non-annexed files.
Otherwise, adding a file and then recomputing it would vary in
what the content of the file is, depending on annex.smallfiles setting.
+
projects / git-annex.git / commitdiff